home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / packages / autoinsert.el.z / autoinsert.el (.txt)
Encoding:
LaTeX Document  |  1998-05-21  |  9.5 KB  |  230 lines
  1. ;;; autoinsert.el --- automatic mode-dependent insertion of text into new files
  2. ;; Copyright (C) 1985, 1986, 1987, 1994, 1995 Free Software Foundation, Inc.
  3. ;; Author: Charlie Martin <crm@cs.duke.edu>
  4. ;; Adapted-By: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
  5. ;; This file is part of XEmacs.
  6. ;; XEmacs is free software; you can redistribute it and/or modify it
  7. ;; under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 2, or (at your option)
  9. ;; any later version.
  10. ;; XEmacs is distributed in the hope that it will be useful, but
  11. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13. ;; General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  16. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  17. ;; 02111-1307, USA.
  18. ;;; Synched up with: FSF 19.34.
  19. ;;; Commentary:
  20. ;;  The following defines an association list for text to be
  21. ;;  automatically inserted when a new file is created, and a function
  22. ;;  which automatically inserts these files; the idea is to insert
  23. ;;  default text much as the mode is automatically set using
  24. ;;  auto-mode-alist.
  25. ;;  To use: 
  26. ;;     (add-hook 'find-file-hooks 'auto-insert)
  27. ;;     setq auto-insert-directory to an appropriate slash-terminated value
  28. ;;  Author:  Charlie Martin
  29. ;;           Department of Computer Science and
  30. ;;           National Biomedical Simulation Resource
  31. ;;           Box 3709
  32. ;;           Duke University Medical Center
  33. ;;           Durham, NC 27710
  34. ;;          (crm@cs.duke.edu,mcnc!duke!crm) 
  35. ;;; Code:
  36. (defgroup auto-insert nil
  37.   "Automatic mode-dependent insertion of text into new files."
  38.   :group 'tools)
  39. (defcustom auto-insert 'not-modified
  40.   "*Controls automatic insertion into newly found empty files:
  41.     nil    do nothing
  42.     t    insert if possible
  43.     other    insert if possible, but mark as unmodified.
  44. Insertion is possible when something appropriate is found in
  45. `auto-insert-alist'.  When the insertion is marked as unmodified, you can
  46. save it with  \\[write-file] RET.
  47. This variable is used when `auto-insert' is called as a function, e.g.
  48. when you do (add-hook 'find-file-hooks 'auto-insert).
  49. With \\[auto-insert], this is always treated as if it were `t'."
  50.   :type '(radio (const :tag "Do nothing" nil)
  51.         (const :tag "Insert if possible" t)
  52.         (sexp :format "%t\n"
  53.               :tag "Insert if possible, but mark as unmodified"
  54.               other))
  55.   :require 'autoinsert
  56.   :group 'auto-insert)
  57. (defcustom auto-insert-query 'function
  58.   "*If non-`nil', ask user before auto-inserting.
  59. When this is `function', only ask when called non-interactively."
  60.   :type '(choice (const :tag "Don't ask" nil)
  61.          (const :tag "Ask when non-interactive" function)
  62.          (sexp :format "%t\n" :tag "Ask" other))
  63.   :group 'auto-insert)
  64. (defcustom auto-insert-prompt "Perform %s auto-insertion? "
  65.   "*Prompt to use when querying whether to auto-insert.
  66. If this contains a %s, that will be replaced by the matching rule."
  67.   :type 'string
  68.   :group 'auto-insert)
  69. (defvar auto-insert-alist
  70.   '((("\\.\\([Hh]\\|hh\\|hpp\\)\\'" . "C / C++ header")
  71.      (upcase (concat (file-name-nondirectory
  72.               (substring buffer-file-name 0 (match-beginning 0)))
  73.              "_"
  74.              (substring buffer-file-name (1+ (match-beginning 0)))))
  75.      "#ifndef " str \n
  76.      "#define " str "\n\n"
  77.      _ "\n\n#endif")
  78.     (("\\.\\([Cc]\\|cc\\|cpp\\)\\'" . "C / C++ program")
  79.      nil
  80.      "#include \""
  81.      ;; nop without latest cc-mode
  82.      (and (fboundp 'c-companion-file)
  83.       ;(file-readable-p (c-companion-file 'name))
  84.       (file-name-nondirectory (c-companion-file 'name))) & ?\"
  85.      | -10)
  86.     ("[Mm]akefile\\'" . "makefile.inc")
  87.     (html-mode . (lambda () (sgml-tag "html")))
  88.     (plain-tex-mode . "tex-insert.tex")
  89.     (bibtex-mode . "tex-insert.tex")
  90.     (latex-mode
  91.      ;; should try to offer completing read for these
  92.      "options, RET: "
  93.      "\\documentstyle[" str & ?\] | -1
  94.      ?{ (read-string "class: ") "}\n"
  95.      ("package, %s: "
  96.       "\\usepackage[" (read-string "options, RET: ") & ?\] | -1 ?{ str "}\n")
  97.      _ "\n\\begin{document}\n" _
  98.      "\n\\end{document}")
  99.     (("/bin/.*[^/]\\'" . "Shell-Script mode magic number")
  100.      lambda ()
  101.        (if (eq major-mode default-major-mode)
  102.      (sh-mode)))
  103.     (ada-mode . ada-header)
  104.     (("\\.el\\'" . "Emacs Lisp header")
  105.      "Short description: "
  106.      ";;; " (file-name-nondirectory (buffer-file-name)) " --- " str "
  107. ;; Copyright (C) " (substring (current-time-string) -4) " by "
  108.  (getenv "ORGANIZATION") | "Free Software Foundation, Inc." "
  109. ;; Author: " (user-full-name)
  110. '(if (search-backward "&" (save-excursion (beginning-of-line 1) (point)) t)
  111.      (replace-match (capitalize (user-login-name)) t t))
  112. '(end-of-line 1) " <" (user-login-name) ?@ (system-name) ">
  113. ;; Keywords: "
  114.  '(require 'finder)
  115.  ;;'(setq v1 (apply 'vector (mapcar 'car finder-known-keywords)))
  116.  '(setq v1 (mapcar (lambda (x) (list (symbol-name (car x))))
  117.            finder-known-keywords)
  118.     v2 (mapconcat (lambda (x) (format "%10.0s:  %s" (car x) (cdr x)))
  119.        finder-known-keywords
  120.        "\n"))
  121.  ((let ((minibuffer-help-form v2))
  122.     (completing-read "Keyword, C-h: " v1 nil t))
  123.     str ", ") & -2 "
  124. ;; This file is part of XEmacs.
  125. ;; XEmacs is free software; you can redistribute it and/or modify it
  126. ;; under the terms of the GNU General Public License as published by
  127. ;; the Free Software Foundation; either version 2, or (at your option)
  128. ;; any later version.
  129. ;; XEmacs is distributed in the hope that it will be useful, but
  130. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  131. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  132. ;; General Public License for more details.
  133. ;; You should have received a copy of the GNU General Public License
  134. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  135. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  136. ;; 02111-1307, USA.
  137. ;;; Synched up with: Not in FSF
  138. ;;; Commentary:
  139. ;; " _ "
  140. ;;; Code:
  141. (provide '" (file-name-sans-extension (file-name-nondirectory
  142. (buffer-file-name))) ")
  143. ;;; " (file-name-nondirectory (buffer-file-name)) " ends here
  144.   "A list specifying text to insert by default into a new file.
  145. Elements look like (CONDITION . ACTION) or ((CONDITION . DESCRIPTION) . ACTION).
  146. CONDITION maybe a regexp that must match the new file's name, or it may be
  147. a symbol that must match the major mode for this element to apply.
  148. Only the first matching element is effective.
  149. Optional DESCRIPTION is a string for filling `auto-insert-prompt'.
  150. ACTION may be a skeleton to insert (see `skeleton-insert'), an absolute
  151. file-name or one relative to `auto-insert-directory' or a function to call.
  152. ACTION may also be a vector containing several successive single actions as
  153. described above, e.g. [\"header.insert\" date-and-author-update].")
  154. ;; Establish a default value for auto-insert-directory
  155. (defvar auto-insert-directory "~/insert/"
  156.   "*Directory from which auto-inserted files are taken.")
  157. ;;;###autoload
  158. (defun auto-insert ()
  159.   "Insert default contents into a new file if `auto-insert' is non-nil.
  160. Matches the visited file name against the elements of `auto-insert-alist'."
  161.   (interactive)
  162.   (and (not buffer-read-only)
  163.        (or (eq this-command 'auto-insert)
  164.        (and auto-insert
  165.         (bobp) (eobp)))
  166.        (let ((alist auto-insert-alist)
  167.          case-fold-search cond desc action)
  168.      (goto-char 1)
  169.      ;; find first matching alist entry
  170.      (while alist
  171.        (if (atom (setq cond (car (car alist))))
  172.            (setq desc cond)
  173.          (setq desc (cdr cond)
  174.            cond (car cond)))
  175.        (if (if (symbolp cond)
  176.            (eq cond major-mode)
  177.          (string-match cond buffer-file-name))
  178.            (setq action (cdr (car alist))
  179.              alist nil)
  180.          (setq alist (cdr alist))))
  181.      ;; Now, if we found something, do it
  182.      (and action
  183.           (if (stringp action)
  184.           (file-readable-p (concat auto-insert-directory action))
  185.           (if auto-insert-query
  186.           (or (if (eq auto-insert-query 'function)
  187.               (eq this-command 'auto-insert))
  188.               (y-or-n-p (format auto-insert-prompt desc)))
  189.           (mapcar
  190.            (lambda (action)
  191.          (if (stringp action)
  192.              (if (file-readable-p
  193.               (setq action (concat auto-insert-directory action)))
  194.              (insert-file-contents action))
  195.            (save-window-excursion
  196.              ;; make buffer visible before skeleton or function
  197.              ;; which might ask the user for something
  198.              (switch-to-buffer (current-buffer))
  199.              (if (and (consp action)
  200.                   (not (eq (car action) 'lambda)))
  201.              (skeleton-insert action)
  202.                (funcall action)))))
  203.            (if (vectorp action)
  204.            action
  205.          (vector action))))
  206.      (and (buffer-modified-p)
  207.           (not (eq this-command 'auto-insert))
  208.           (set-buffer-modified-p (eq auto-insert t))))))
  209. ;;;###autoload
  210. (defun define-auto-insert (key action &optional after)
  211.   "Associate CONDITION with (additional) ACTION in `auto-insert-alist'.
  212. Optional AFTER means to insert action after all existing actions for CONDITION,
  213. or if CONDITION had no actions, after all other CONDITIONs."
  214.   (let ((elt (assoc key auto-insert-alist)))
  215.     (if elt
  216.     (setcdr elt
  217.         (if (vectorp (cdr elt))
  218.             (vconcat (if after (cdr elt))
  219.                  (if (vectorp action) action (vector action))
  220.                  (if after () (cdr elt)))
  221.           (if after
  222.               (vector (cdr elt) action)
  223.             (vector action (cdr elt)))))
  224.       (if after
  225.       (nconc auto-insert-alist (list (cons key action)))
  226.     (setq auto-insert-alist (cons (cons key action)
  227.                       auto-insert-alist))))))
  228. (provide 'autoinsert)
  229. ;;; autoinsert.el ends here
  230.